Visual Basic Source Code/Visual Basic Source Code.iso/vbsource/tcpcli1a/craigsam.frm

Visual Basic Form | 1999-07-22 | 10.9 KB | 279 lines

VERSION 5.00
Object = "{248DD890-BB45-11CF-9ABC-0080C7E7B78D}#1.0#0"; "MSWINSCK.OCX"
Begin VB.Form Form1
   BorderStyle     =   1  'Fixed Single
   Caption         =   "Intergrated TCP/IP Client Server Example Application"
   ClientHeight    =   3915
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   8505
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   3915
   ScaleWidth      =   8505
   StartUpPosition =   3  'Windows Default
   Begin MSWinsockLib.Winsock Server
      Left            =   3360
      Top             =   1920
      _ExtentX        =   741
      _ExtentY        =   741
      _Version        =   393216
   End
   Begin MSWinsockLib.Winsock Client
      Left            =   2880
      Top             =   1920
      _ExtentX        =   741
      _ExtentY        =   741
      _Version        =   393216
   End
   Begin VB.Timer ConnectionTimeout
      Enabled         =   0   'False
      Interval        =   5000
      Left            =   2400
      Top             =   1920
   End
   Begin VB.Frame Frame2
      Caption         =   "Server"
      Height          =   3015
      Left            =   4320
      TabIndex        =   1
      Top             =   120
      Width           =   3975
      Begin VB.ListBox lstServerLog
         Height          =   840
         Left            =   240
         TabIndex        =   16
         Top             =   1560
         Width           =   3495
      End
      Begin VB.CommandButton cmdServerListen
         Caption         =   "Listen"
         Height          =   375
         Left            =   2160
         TabIndex        =   6
         Top             =   2520
         Width           =   1575
      End
      Begin VB.TextBox txtServerLocalIP
         Height          =   285
         Left            =   1440
         Locked          =   -1  'True
         TabIndex        =   5
         Top             =   840
         Width           =   1935
      End
      Begin VB.TextBox txtServerPort
         Height          =   285
         Left            =   1440
         TabIndex        =   4
         Text            =   "2400"
         Top             =   480
         Width           =   1935
      End
      Begin VB.Label Label6
         Caption         =   "Status"
         Height          =   255
         Left            =   240
         TabIndex        =   15
         Top             =   1200
         Width           =   1095
      End
      Begin VB.Label lblServerStatus
         Caption         =   "Server is idle"
         Height          =   255
         Left            =   1440
         TabIndex        =   13
         Top             =   1200
         Width           =   1935
      End
      Begin VB.Label Label2
         Caption         =   "Local IP"
         Height          =   255
         Left            =   240
         TabIndex        =   3
         Top             =   840
         Width           =   1575
      End
      Begin VB.Label Label1
         Caption         =   "Listen on Port"
         Height          =   255
         Left            =   240
         TabIndex        =   2
         Top             =   480
         Width           =   1815
      End
   End
   Begin VB.Frame Frame1
      Caption         =   "Client"
      Height          =   3015
      Left            =   120
      TabIndex        =   0
      Top             =   120
      Width           =   4095
      Begin VB.CommandButton cmdConnect
         Caption         =   "Connect"
         Height          =   375
         Left            =   2280
         TabIndex        =   11
         Top             =   2520
         Width           =   1575
      End
      Begin VB.TextBox txtClientIP
         Height          =   285
         Left            =   1560
         TabIndex        =   10
         Top             =   840
         Width           =   1935
      End
      Begin VB.TextBox txtClientPort
         Height          =   285
         Left            =   1560
         TabIndex        =   9
         Text            =   "2400"
         Top             =   480
         Width           =   1935
      End
      Begin VB.Label Label5
         Caption         =   "Status"
         Height          =   255
         Left            =   240
         TabIndex        =   14
         Top             =   1200
         Width           =   1215
      End
      Begin VB.Label lblClientStatus
         Caption         =   "Not Connected"
         Height          =   255
         Left            =   1560
         TabIndex        =   12
         Top             =   1200
         Width           =   1935
      End
      Begin VB.Label Label4
         Caption         =   "IP to connect to"
         Height          =   255
         Left            =   240
         TabIndex        =   8
         Top             =   840
         Width           =   1575
      End
      Begin VB.Label Label3
         Caption         =   "Connect to Port"
         Height          =   255
         Left            =   240
         TabIndex        =   7
         Top             =   480
         Width           =   1815
      End
   End
   Begin VB.Label Label8
      Caption         =   "For More Information contact [e-mail]"
      Height          =   255
      Left            =   120
      TabIndex        =   18
      Top             =   3480
      Width           =   6255
   End
   Begin VB.Label Label7
      Caption         =   "Intergrated TCP/IP Client Server Example Application"
      Height          =   375
      Left            =   120
      TabIndex        =   17
      Top             =   3240
      Width           =   5895
   End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub Client_Connect()
ConnectionTimeout.Enabled = False  'The Client found a server and so the timeout is avoided
lblClientStatus = "Connected . . . " 'Update the server status. This wont be visible if
                                     'using the localhost mode because it goes so fast,
                                     'however it is noticable over the internet
End Sub
Private Sub Client_DataArrival(ByVal bytesTotal As Long)
Dim txt As String 'Dont really need this because I dont use Option Explicit
Client.GetData txt, vbString 'Get the server command
    If UCase(txt) = "CLOSECONNECTION" Then 'Process command - this one terminates the connection
        Client.Close 'Close client socket
        lblClientStatus = "Closing Connection . . ." 'Update Client Status
        cmdConnect.Enabled = True 'Enabled the Connect Button to allow the test to be re-run
    End If
lblClientStatus = "Not Connected" 'Update the client status
End Sub
Private Sub cmdConnect_Click()
ConnectionTimeout.Enabled = True    'Activate the timeout timer so that if there is no connection
                                    'within the specified time (I set it as 5 secs), then assume
                                    'that there is no server availible.
If txtClientIP = "" Then    'Make sure that there is an IP of some sort
    MsgBox "Must have a server IP to connect to!", vbExclamation, "Client Error"
    Exit Sub
ElseIf txtClientPort = "" Then 'make sure that a port is entered
    MsgBox "Must have port to connect on!!", vbExclamation, "Client Error"
    Exit Sub
End If
If LCase(txtClientIP) = LCase("localhost") Then 'This function will allow you to enter 'localhost'
                                                'instead of typing 127.0.0.1 or your local IP
    Client.RemoteHost = "127.0.0.1"
    Client.RemoteHost = txtClientIP   'if not 'localhost' set as the contents of the textbox
End If
    Client.RemotePort = txtClientPort 'This is the server port to connect to
                                      'not the Client.LocalPort (use to route)
    If Client.State <> sckConnected Then 'if not connected alreay, proceed to connect
        Client.Connect
    Else  'Must already be connected, display error end exit sub
       MsgBox "Client is already connected!", vbExclamation, "Client Error"
       Exit Sub
    End If
    lblClientStatus = "Attempting Connection . . ." 'Update client status
    cmdConnect.Enabled = False    'Disable the cutton to prevent constant clicking suring processing
End Sub
Private Sub cmdServerListen_Click()
cmdServerListen.Enabled = False 'Disable the cutton to prevent constant clicking suring processing
lblServerStatus = "Listening For Connections . . . " 'Update server status
If txtServerPort = "" Then 'Validation
    MsgBox "Must have port to listen on!!", vbExclamation, "Server Error"
    Exit Sub
End If
    Server.LocalPort = Int(txtServerPort) 'Unsure is the Int() function is really needed.
                                          'but it aint doing any harm 8-)
If Server.State <> sckConnected Then 'if not already connected then proceed to listen
    Server.Listen
Else 'Must already be connected, error message and exit sub
    MsgBox "Server is already connected!", vbExclamation, "Server Error"
    Exit Sub
End If
End Sub
Private Sub ConnectionTimeout_Timer()
    MsgBox "Client could not find server after " & ConnectionTimeout.Interval / 1000 & " seconds.", vbExclamation, "Client Error"
    'Display an error message. The math is just in case you change the timout interval
    If Client.State <> sckClosed Then 'If socket is not closed then close it
        Client.Close
    End If
    cmdConnect.Enabled = True 'Enabled button for retry
    ConnectionTimeout.Enabled = False 'Disable timer to prevent 'Ghost' errors
    lblClientStatus = "Not Connected" 'Upadte Client Status
End Sub
Private Sub Form_Load()
txtServerLocalIP = Server.LocalIP 'Set default values
txtClientIP = "localhost"
End Sub
Private Sub Server_ConnectionRequest(ByVal requestID As Long)
If Server.State = sckConnected Then 'If connected then error message and exit sub
    MsgBox "Server is already connected!", vbExclamation, "Server Error"
    Exit Sub
End If
    Server.Close 'Close the connection (stop listening)
    Server.Accept requestID 'Connect to client
    lblServerStatus = "Processing Connection . . ." 'Update server status
    lstServerLog.AddItem Time & " - " & "Client Connected" 'Add entry to log
    Server.SendData "CLOSECONNECTION" 'Send termination command
    DoEvents 'Allow the termination command to be sent (give client time to close socket)
    Server.Close 'Shutdown connection from this end
    cmdServerListen.Enabled = True 'Enabled button to allow furthur testing
    lblServerStatus = "Server Idle" 'Update server status
End Sub